home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 October / EnigmA AMIGA RUN 22 (1997)(G.R. Edizioni)(IT)[!][issue 1997-10 & 11][EAR-CD VI].iso / progs / devel / pcq12d_2 / examples / bobtest.p < prev    next >
Text File  |  1991-09-06  |  7KB  |  299 lines
  1. Program BOBTest;
  2.  
  3. {
  4.     This program is based on BobTest.c from the original RKM
  5.     example set.  It simply creates a BOB, then moves it
  6.     around the window until you close the window.
  7.  
  8.     Besides Intuition BOBs, this program demonstrates the use
  9.     of PCQ's CHIP keyword to specify that a global variable or
  10.     typed constant should be placed in the Amiga's chip memory.
  11.  
  12. }
  13.  
  14. {$I "Include:Graphics/Gfx.i"}
  15. {$I "Include:Graphics/Rastport.i"}
  16. {$I "Include:Graphics/View.i"}
  17. {$I "Include:Exec/Exec.i"}
  18. {$I "Include:Graphics/Gels.i"}
  19. {$I "Include:Intuition/Intuition.i"}
  20. {$I "Include:Graphics/Graphics.i"}
  21. {$I "Include:Graphics/Pens.i"}
  22.  
  23. Const
  24.     ScreenDepth  = 3;
  25.  
  26.     ObjectWidth  = 48; { Three words wide  }
  27.     ObjectHeight = 30; { Thirty lines tall }
  28.  
  29.     ObjectWords  = (ObjectWidth + 15) div 16;
  30.  
  31.     Memory_Flags = MEMF_PUBLIC or MEMF_CHIP or MEMF_CLEAR;
  32.  
  33. Var
  34.     w    : WindowPtr;
  35.     s    : ScreenPtr;
  36.     rp    : RastPortPtr;
  37.     vp    : ViewPortPtr;
  38.  
  39. Const
  40.     TestFont : TextAttr = ("topaz.font", 8, 0, 0);
  41.  
  42.     ns    : NewScreen = (
  43.     0,0,            { start position               }
  44.     320, 200, ScreenDepth,
  45.     0, 1,            { detail pen, block pen        }
  46.     0,            { viewing mode (was HIRES)     }
  47.     CUSTOMSCREEN_f,        { screen type                  }
  48.     @TestFont,        { font to use                  }
  49.     "GELS Example Program",    { default title for screen     }
  50.     Nil,            { pointer to additional gadgets }
  51.     Nil
  52.     );
  53.  
  54.     WINDOWFLAGS = GIMMEZEROZERO or WINDOWDRAG or WINDOWSIZING or
  55.           WINDOWDEPTH or WINDOWCLOSE or ACTIVATE;
  56.  
  57.     nw    : NewWindow = (
  58.         20, 20,                 { start position               }
  59.         220, 150,               { width, height                }
  60.         -1, -1,                 { detail pen, block pen        }
  61.         CLOSEWINDOW_f,        { IDCMP flags                  }
  62.         WINDOWFLAGS,        { window flags                 }
  63.         Nil,                    { pointer to first user gadget }
  64.         Nil,                    { pointer to user checkmark    } 
  65.         "Bouncing BOB",         { window title         } 
  66.         Nil,                    { pointer to screen    (later) }
  67.         Nil,                    { pointer to superbitmap       }
  68.         30,20,-1,-1,            { sized window }
  69.         CUSTOMSCREEN_f          { type of screen in which to open }   
  70.         );
  71.  
  72.  
  73.     Images : CHIP Array [0..Pred(ObjectWords*ObjectHeight*Pred(ScreenDepth))] of Short = (
  74.         $FFFF, $0000, $FFFF,
  75.         $FFFF, $0000, $FFFF,
  76.         $FFFF, $0000, $FFFF,
  77.         $FFFF, $0000, $FFFF,
  78.         $FFFF, $0000, $FFFF,
  79.         $FFFF, $0000, $FFFF,
  80.         $FFFF, $0000, $FFFF,
  81.         $FFFF, $0000, $FFFF,
  82.         $FFFF, $0000, $FFFF,
  83.         $FFFF, $0000, $FFFF,
  84.         $FFFF, $0000, $FFFF,
  85.         $FFFF, $0000, $FFFF,
  86.         $FFFF, $0000, $FFFF,
  87.         $FFFF, $0000, $FFFF,
  88.         $FFFF, $0000, $FFFF,
  89.         $FFFF, $0000, $FFFF,
  90.         $FFFF, $0000, $FFFF,
  91.         $FFFF, $0000, $FFFF,
  92.         $FFFF, $0000, $FFFF,
  93.         $FFFF, $0000, $FFFF,
  94.         $FFFF, $0000, $FFFF,
  95.         $FFFF, $0000, $FFFF,
  96.         $FFFF, $0000, $FFFF,
  97.         $FFFF, $0000, $FFFF,
  98.         $FFFF, $0000, $FFFF,
  99.         $FFFF, $0000, $FFFF,
  100.         $FFFF, $0000, $FFFF,
  101.         $FFFF, $0000, $FFFF,
  102.         $FFFF, $0000, $FFFF,
  103.         $FFFF, $0000, $FFFF,
  104.  
  105.         $0000, $FFFF, $FFFF,
  106.         $0000, $FFFF, $FFFF,
  107.         $0000, $FFFF, $FFFF,
  108.         $0000, $FFFF, $FFFF,
  109.         $0000, $FFFF, $FFFF,
  110.         $0000, $FFFF, $FFFF,
  111.         $0000, $FFFF, $FFFF,
  112.         $0000, $FFFF, $FFFF,
  113.         $0000, $FFFF, $FFFF,
  114.         $0000, $FFFF, $FFFF,
  115.         $0000, $FFFF, $FFFF,
  116.         $0000, $FFFF, $FFFF,
  117.         $0000, $FFFF, $FFFF,
  118.         $0000, $FFFF, $FFFF,
  119.         $0000, $FFFF, $FFFF,
  120.         $0000, $FFFF, $FFFF,
  121.         $0000, $FFFF, $FFFF,
  122.         $0000, $FFFF, $FFFF,
  123.         $0000, $FFFF, $FFFF,
  124.         $0000, $FFFF, $FFFF,
  125.         $0000, $FFFF, $FFFF,
  126.         $0000, $FFFF, $FFFF,
  127.         $0000, $FFFF, $FFFF,
  128.         $0000, $FFFF, $FFFF,
  129.         $0000, $FFFF, $FFFF,
  130.         $0000, $FFFF, $FFFF,
  131.         $0000, $FFFF, $FFFF,
  132.         $0000, $FFFF, $FFFF,
  133.         $0000, $FFFF, $FFFF,
  134.         $0000, $FFFF, $FFFF);
  135.  
  136.  
  137. var
  138.     s1, s2    : VSprite;    { dummy sprites for gels list }
  139.     mygelsinfo    : GelsInfo;    { gelsinfo to link into system rastport }
  140.     collisiontable    : collTable;
  141.  
  142.     v    : VSprite;
  143.     b    : Bob;
  144.  
  145.     i    : Short;
  146.  
  147.     UsedMemory    : RememberPtr;
  148.  
  149.     xspeed    : Short;
  150.     yspeed    : Short;
  151.  
  152.     BackBuffer    : CHIP Array [0..Pred(Succ(ObjectWords) * ObjectHeight * ScreenDepth)] of Short;
  153.  
  154.     CMask    : CHIP Array [0..Pred(ObjectWords * ObjectHeight)] of Short;
  155.     BorderMask    : CHIP Array [0..Pred(ObjectWords)] of Short;
  156.  
  157.  
  158. Procedure InitializeBOB;
  159. begin
  160.     with MyGelsInfo do begin
  161.     nextLine  := Nil;
  162.     lastColor := Nil;
  163.     collHandler := @collisiontable;
  164.     end;
  165.  
  166.     InitGels(@s1, @s2, @MyGelsInfo);
  167.     rp^.GelsInfo := @MyGelsInfo;
  168.  
  169.     with v do begin
  170.     X       := 20;
  171.     Y       := 4;
  172.     Flags   := OVERLAY + SAVEBACK;
  173.     Height  := ObjectHeight;
  174.     Width   := ObjectWords;
  175.     Depth   := ScreenDepth;
  176.  
  177.     MeMask  := 1;
  178.     HitMask := 1;
  179.  
  180.     ImageData := @Images;    { Point VSprite to image data }
  181.     CollMask  := @CMask;    { Point to collision mask area }
  182.     BorderLine := @BorderMask; { Point to border mask area }
  183.  
  184.     InitMasks(@v);        { Set up collision & border masks }
  185.  
  186.     PlanePick := $03;     { Just use first two planes }
  187.     PlaneOnOff := 4;      { Set third plane solid }
  188.     end;
  189.  
  190.         { ****************** now initialize the Bob variables ******* }       
  191.  
  192.     with b do begin
  193.     Flags := 0;
  194.     SaveBuffer := @BackBuffer;  { show where to save background }
  195.     ImageShadow := @CMask;   { collision and shadow are same }
  196.     Before := Nil;        { dont care about drawing order }
  197.     After := Nil; 
  198.  
  199.     BobComp := Nil;       { not animation component }
  200.     DBuffer := Nil;       { not double buffered }
  201.  
  202.     BobVSprite := @v;      { link to the VSprite }
  203.     end;
  204.  
  205.     v.VSBob := @b;        { Link the VSprite to the BOB }
  206.  
  207.     AddBob(@b, rp);        { Add to the GELS list }
  208.     SortGList(rp);        { Sort it for drawing }
  209.     WaitTOF;            { Sync with beam }
  210.     DrawGList(rp,vp);        { Draw the BOBs, etc. }
  211. end;
  212.  
  213. Procedure MoveBOB;
  214. var
  215.     M : MessagePtr;
  216. begin
  217.     while true do begin
  218.     Inc(b.BobVSprite^.Y,yspeed);
  219.         if b.BobVSprite^.Y > (w^.GZZHeight - ObjectHeight) then
  220.         yspeed := -yspeed
  221.     else
  222.         Inc(yspeed);
  223.  
  224.     Inc(b.BobVSprite^.X,xspeed);
  225.         if (b.BobVSprite^.X >= (w^.GZZWidth - ObjectWidth)) or
  226.        (b.BobVSprite^.X <= 0) then
  227.         xspeed := -xspeed;
  228.  
  229.         SortGList(rp);
  230.         WaitTOF;
  231.         DrawGList(rp,vp);
  232.     M := GetMsg(w^.UserPort);
  233.     if M <> Nil then begin
  234.         ReplyMsg(M);
  235.         return;
  236.     end;
  237.     end;
  238. end;
  239.  
  240.  
  241. Procedure Setup;
  242. var
  243.     i : Short;
  244.     p : Byte;
  245. begin
  246.     UsedMemory := Nil;    { To keep track of allocations }
  247.  
  248.     GfxBase := OpenLibrary("graphics.library", 0);
  249.     if GfxBase = Nil then begin
  250.     Writeln("Unable to open graphics library");
  251.     exit(20);
  252.     end;
  253.  
  254.     s := OpenScreen(@ns);
  255.     nw.Screen := s;
  256.  
  257.     w := OpenWindow(@nw);            { open a window }
  258.     rp := w^.RPort;
  259.     vp := ViewPortAddress(w);
  260.  
  261.     xspeed := 2;
  262.     yspeed := 0;
  263.  
  264.     SetRGB4(vp,5, 0, 0,12);    { Set flag colors to blue...}
  265.     SetRGB4(vp,6,15,15,15);    { white }
  266.     SetRGB4(vp,7,12, 0, 0);    { red }
  267.  
  268.     { Draw some sort of pattern in the window to show that }
  269.     { we aren't messing it up.                             }
  270.  
  271.     p := 1;
  272.     SetAPen(rp,p);
  273.     for i := 0 to w^.GZZWidth do begin
  274.     Move(rp,i,0);
  275.     Draw(rp,w^.GZZWidth - i,w^.GZZheight);
  276.     p := Succ(p) and 3;
  277.     SetAPen(rp,p);
  278.     end;
  279.     for i := 0 to w^.GZZheight do begin
  280.     Move(rp, 0, i);
  281.     Draw(rp, w^.GZZWidth, w^.GZZheight - i);
  282.     p := Succ(p) and 3;
  283.     SetAPen(rp,p);
  284.     end;
  285. end;
  286.  
  287. begin
  288.     SetUp;
  289.     InitializeBOB;
  290.     MoveBOB; 
  291.  
  292.     RemBob(@b);
  293.  
  294.     FreeRemember(UsedMemory,True);
  295.     CloseWindow(w);
  296.     CloseScreen(s);
  297.     CloseLibrary(GfxBase);
  298. end.
  299.